package gri_backend_cache;

use Data::Dumper;
use File::Basename;
use Config;

sub new {
my $self={};
my $internal_bzip2=1;
my $internal_gzip=1;
my $internal_zip=1;

	#################################################################
	# Work out whether internal compression handlers are available	#
	#################################################################
	eval 'use IO::Uncompress::Bunzip2;';
	eval 'use IO::Compress::Bzip2;';
	$internal_bzip2=0 if $@;
	eval 'use IO::Uncompress::Unzip;';
	eval 'use IO::Compress::Zip;';
	$internal_zip=0 if $@;
	eval 'use IO::Uncompress::Gunzip;';
	eval 'use IO::Compress::Gzip;';
	$internal_gzip=0 if $@;

	my @P=qw(/usr/bin /bin /usr/sbin /usr/local/bin /usr/contrib/bin /opt/oss/bin);
	$self->{flush}=time;
	$self->{cache}={};
	$self->{gunzip}=undef;
	$self->{zcat}=undef;

	if($Config{osname} !~ /mswin/i) {
		for my $p (@P) {
			if(-x "$p/zcat") {
				$self->{zcat}="$p/zcat"; last;
			}
		}
	}
	if($internal_zip) {
		$self->{unzip}="INTERNAL";
	}
	if($internal_gzip) {
		$self->{gunzip}="INTERNAL";
	} else {
		for my $p (@P) {
			if(-x "$p/gunzip") {
				$self->{gunzip}="$p/gunzip"; last;
			}
		}
	}
	if($internal_bzip2) {
		$self->{bunzip2}="INTERNAL";
	} else {
		for my $p (@P) {
			if(-x "$p/bunzip2") {
				$self->{gunzip}="$p/bunzip2"; last;
			}
		}
	}

	if($Config{osname} !~ /mswin/i) {
		if(!defined($self->{zcat})) {
			die("Can not find the 'zcat' command");
		}
	}
	if(!defined($self->{gunzip})) {
		die("Can not find the 'gunzip' command");
	}

	bless($self);
	return($self);
}


sub sort_reports($$) {
my $directory=$_[0];
my $format=$_[1];
my ($dom,$moy,$year)=(-1,-1,-1);
my ($dom_type,$moy_type,$year_type)=(undef,undef,undef);

my %mon_map = (
	"jan"	=> 1,
	"feb"	=> 2,
	"mar"	=> 3,
	"apr"	=> 4,
	"may"	=> 5,
	"jun"	=> 6,
	"jul"	=> 7,
	"aug"	=> 8,
	"sep"	=> 9,
	"oct"	=> 10,
	"nov"	=> 11,
	"dec"	=> 12,
);

	#################################################################
	# We need to get the relative offsets of the componets so	#
	# we can do the sorting.					#
	#################################################################
	my ($hour,$min,$sec)=(-1,-1,-1);
	my ($hour_type,$min_type,$sec_type)=("","","");
	$hour=index($format,'%1'); if($hour>=0) {$hour_type='%1';}
	$min=index($format,'%2'); if($min>=0) {$min_type='%2';}
	$sec=index($format,'%3'); if($sec>=0) {$sec_type='%3';}

	$dom=index($format,'%d'); if($dom>=0) {$dom_type='%d';}
	$moy=index($format,'%mn'); if($moy>=0) {$moy_type='%mn';}
	if($moy==-1) {
		$moy=index($format,'%MN'); if($moy>=0) {$moy_type='%MN';}
	}
	if($moy==-1) {
		$moy=index($format,'%a'); if($moy>=0) {$moy_type='%a';}
	}
	$year=index($format,'%yyy'); if($year>=0) {$year_type='%yyy';}
	if($year==-1) {
		$year=index($format,'%s'); if($year>=0) {$year_type='%s';}
	}

	my %info_cache=();
	#################################################################
	# Abort if year/month are missing.				#
	#################################################################
	# return(undef,undef) if($moy==-1 || $year==-1);
	
my %format_mapping = (
	'%d'		=> ["([0-9]{2})",2],
	'%mn'		=> ["(jan|feb|mar|apr|may|jun|jul|aug|sep|oct|nov|dec)",3],
	'%MN'		=> ["(JAN|FEB|MAR|APR|MAY|JUN|JUL|AUG|SEP|OCT|NOV|DEC)",3],
	'%a'		=> ["([0-9]{2})",2],
	'%yyy'		=> ["([0-9]{4})",4],
	'%s'		=> ["([0-9]{2})",2],
	'%1'		=> ["([0-9]{2})",2],
	'%2'		=> ["([0-9]{2})",2],
	'%3'		=> ["([0-9]{2})",2],
	);

	#################################################################
	# Firstly what we do is to take the format and generate a	#
	# pattern from it.						#
	#################################################################
	my $new=$format;
	for my $ckey (keys %format_mapping) {
		my $repl=$format_mapping{$ckey}->[0];
		$new =~ s/$ckey/$repl/g;
	}

	my @D=();
	my ($dfd,$cline);
	opendir($dfd,$directory) or return(undef,undef);
	while($cline=readdir($dfd)) {
		if(-f "$directory/$cline") {
			if($cline =~ /^$new/) {
				my @s=stat(_);
				$info_cache{$cline}=[$s[7],$s[9]];
				push @D,$cline;
			}
		}
	}
	closedir($dfd);

	my @D2=sort {
		# The first thing we sort against is the year.
		my $l=$format_mapping{$year_type}->[1];
		if($year>-1) {
			my $a_y=int(substr($a,$year,$l));
			my $b_y=int(substr($b,$year,$l));
			if($a_y != $b_y) {return $b_y <=> $a_y;}
		}
		$l=$format_mapping{$moy_type}->[1];
		if($moy>-1) {
			if($moy_type eq '%a') {
				my $a_y=int(substr($a,$moy,$l));
				my $b_y=int(substr($b,$moy,$l));
				if($a_y != $b_y) {return $b_y <=> $a_y;}
			} elsif($moy_type eq '%mn') {
				my $a_y=substr($a,$moy,$l);
				my $b_y=substr($b,$moy,$l);
				my $a_y2=$mon_map{$a_y};
				my $b_y2=$mon_map{$b_y};
				if($a_y2 != $b_y2) {return $b_y2 <=> $a_y2;}
			} else {
				my $a_y=lc(substr($a,$moy,$l));
				my $b_y=lc(substr($b,$moy,$l));
				my $a_y2=$mon_map{$a_y};
				my $b_y2=$mon_map{$b_y};
				if($a_y2 != $b_y2) {return $b_y2 <=> $a_y2;}
			}
		}
		if($dom>-1) {
			$l=$format_mapping{$dom_type}->[1];
			my $a_y=int(substr($a,$dom,$l));
			my $b_y=int(substr($b,$dom,$l));
			if($a_y != $b_y) {return $b_y <=> $a_y;}
		}
		if($hour>-1) {
			$l=$format_mapping{$hour_type}->[1];
			my $a_y=int(substr($a,$hour,$l));
			my $b_y=int(substr($b,$hour,$l));
			if($a_y != $b_y) {return $b_y <=> $a_y;}
		}
		if($min>-1) {
			$l=$format_mapping{$min_type}->[1];
			my $a_y=int(substr($a,$min,$l));
			my $b_y=int(substr($b,$min,$l));
			if($a_y != $b_y) {return $b_y <=> $a_y;}
		}
		if($sec>-1) {
			$l=$format_mapping{$sec_type}->[1];
			my $a_y=int(substr($a,$sec,$l));
			my $b_y=int(substr($b,$sec,$l));
			if($a_y != $b_y) {return $b_y <=> $a_y;}
		}
		return(0);
	} @D;

	#################################################################
	# We need to capture the year,month,day of the entry ..		#
	# not pretty - since mostly a cut-paste of the sort above :(	#
	# Also the hour,min,sec if present...
	#################################################################

	for my $cfile (@D2) {
		my $a=$cfile;
		my @t=localtime($info_cache{$cfile}->[1]);
		my ($c_year,$c_mon,$c_day);
		my $l;
		if(defined($year_type)) {
			$l=$format_mapping{$year_type}->[1];
		}
		if($year>-1) {
			$c_year=int(substr($cfile,$year,$l));
		} else {
			$c_year=1900+$t[5];
		}
		if(defined($moy_type)) {
			$l=$format_mapping{$moy_type}->[1];
		}
		if($moy>-1) {
			if($moy_type eq '%a') {
				$c_mon=int(substr($a,$moy,$l));
			} elsif($moy_type eq '%mn') {
				my $a_y=substr($a,$moy,$l);
				my $c_mon=$mon_map{$a_y};
			} else {
				my $a_y=lc(substr($a,$moy,$l));
				$c_mon=$mon_map{$a_y};
			}
		} else {
			$c_mon=1+$t[4];
		}
		if($dom>-1) {
			$l=$format_mapping{$dom_type}->[1];
			$c_day=int(substr($a,$dom,$l));
		} else {
			$c_day=$t[3];
		}
		my ($c_hour,$c_min,$c_sec);
		if($hour>-1) {
			$l=$format_mapping{$hour_type}->[1];
			$c_hour=int(substr($a,$hour,$l));
		} else {
			$c_hour=$t[2];
		}
		if($min>-1) {
			$l=$format_mapping{$min_type}->[1];
			$c_min=int(substr($a,$min,$l));
		} else {
			$c_min=$t[1];
		}
		if($sec>-1) {
			$l=$format_mapping{$sec_type}->[1];
			$c_sec=int(substr($a,$sec,$l));
		} else {
			$c_sec=$t[0];
		}

		push @{$info_cache{$cfile}},$c_year,$c_mon,$c_day,$c_hour,$c_min,$c_sec;
	}
	return([@D2],{%info_cache});
}

sub check_cache($$$) {
my ($self,$dir,$report)=@_;

	#################################################################
	# If the cache has not been flushed for 24 hours do it now.	#
	#################################################################
	if($self->{flush}+86400 < time) {
		$self->{flush}=time;
		$self->{cache}={};
	}

	#################################################################
	# If the cache entry exists and is more recent than the dir	#
	# modification date then return a ref to entry.			#
	#################################################################

	my $dir_time=(stat($dir))[9];
	my $c="$dir#$report";
	if(exists($self->{cache}->{$c})) {
		if($self->{cache}->{$c}->{mtime}>$dir_time) {
			return $self->{cache}->{$c};
		}
	}

	#################################################################
	# The cache entry is too old or does not exist, so clear it.	#
	#################################################################
	$self->{cache}->{$c}={};
	$self->{cache}->{$c}->{mtime}=time;
	$self->{cache}->{$c}->{files}=[];

	#################################################################
	# Get the sorted list of reports and store name, size and mtime	#
	#################################################################
	my ($replist,$repinfo)=sort_reports($dir,$report);
	if(!defined($replist)) {
		print "No results - is directory '$dir' valid?\n";
	}
	for my $cfile (@$replist) {
		push @{$self->{cache}->{$c}->{files}},[$cfile,@{$repinfo->{$cfile}}];
	}
	return $self->{cache}->{$c};
}

#########################################################################
# Now do each of the available requests...				#
#########################################################################

sub get_latest_report($$$;$) {
my ($self,$dir,$report,$with_total)=@_;

	$with_total=0 if !defined($with_total);
	my $cache_line=check_cache($self,$dir,$report);
	my $c=@{$cache_line->{files}};
	if(!$c) {
		return "__NO_REPORTS__";
	}

	#################################################################
	# The latest report is the first entry in the cache.		#
	#################################################################
	my $ff=$cache_line->{files}->[0];
	if($ff->[3]<2000) {
		$ff->[3]+=2000;
	}
	$ff->[5]=0 if !defined($ff->[5]);
	my $dd=sprintf("%04d.%02d.%02d.%02d.%02d.%02d",$ff->[3],$ff->[4],$ff->[5],$ff->[6],$ff->[7],$ff->[8]);
	# Also return the total number of bytes allocated if called as "
	if($with_total==0) {
		return "$ff->[0]|$ff->[1]|$ff->[2]|$dd|$c";
	}
	my $ss=0;
	for $ff (@{$cache_line->{files}}) {
		$ss+=$ff->[1];
	}
	$ss=int($ss/1024);
	return "$ff->[0]|$ff->[1]|$ff->[2]|$dd|$c|$ss";
}

sub get_report_list($$$) {
my ($self,$dir,$report,$from)=@_;

	$from=0 if !defined($from);
	my $cache_line=check_cache($self,$dir,$report);
	my $c=@{$cache_line->{files}};
	if(!$c) {
		return "0";
	}
	my @R=(0);
	my $count=0;
	for $ff (@{$cache_line->{files}}) {
		if($ff->[2]<$from) {
			next;
		}
		$count++;
		if($ff->[3]<2000) {
			$ff->[3]+=2000;
		}
		$ff->[5]=0 if !defined($ff->[5]);
		my $dd=sprintf("%04d.%02d.%02d.%02d.%02d.%02d",$ff->[3],$ff->[4],$ff->[5],$ff->[6],$ff->[7],$ff->[8]);
		push @R,"$ff->[0]|$ff->[1]|$ff->[2]|$dd";
	}
	$R[0]=$count;
	return join("|",@R);
}

#########################################################################
# Rather than attempting to return the complete report on the stack	#
# just a reference to the value is reported to reduce space.		#
#########################################################################

sub get_report_contents($$$$$) {
my ($self,$dir,$report,$inst,$mtime)=@_;

	$inst--;
	my $cache_line=check_cache($self,$dir,$report);
	my $c=@{$cache_line->{files}};
	if(!$c) {
		return undef; # no such report available
	}

	my $ff;
	if($inst>-1) {
		$ff=$cache_line->{files}->[$inst];
	} else {
		for my $x (@{$cache_line->{files}}) {
			if($x->[2] == $mtime) {
				$ff=$x; last;
			}
		}
	}
	if(!defined($ff)) {
		return undef; # No such report
	}
	my ($fd,$data,$cline)=(undef,"","");
	my $pp; my $internal=0;
	if($ff->[0] =~ /\.gz$/) {
		if(!exists($self->{gunzip}) || !defined($self->{gunzip})) {
			return undef;
		}
		if($self->{gunzip} eq "INTERNAL") {
			$fd=IO::Uncompress::Gunzip->new("$dir/$ff->[0]");
			return(undef) if !defined($fd);
			$internal=1;
		} else {
			$pp="$self->{gunzip} -c $dir/$ff->[0]|";
		}
	} elsif($ff->[0] =~ /\.bz2$/) {
		if(!exists($self->{bunzip2}) || !defined($self->{bunzip2})) {
			return undef;
		}
		if($self->{bunzip2} eq "INTERNAL") {
			$fd=IO::Uncompress::Bunzip2->new("$dir/$ff->[0]");
			return(undef) if !defined($fd);
			$internal=1;
		} else {
			$pp="$self->{gunzip} -c $dir/$ff->[0]|";
		}
	} elsif($ff->[0] =~ /\.zip$/) {
		if(!exists($self->{unzip}) || !defined($self->{gunzip})) {
			return undef;
		}
		if($self->{unzip} eq "INTERNAL") {
			$fd=IO::Uncompress::Unzip->new("$dir/$ff->[0]");
			return(undef) if !defined($fd);
			$internal=1;
		}
	} elsif($ff->[0] =~ /\.Z$/) {
		$pp="$self->{zcat} $dir/$ff->[0]|";
	} else {
		$pp="$dir/$ff->[0]";
	}
	if(!$internal) {
		open($fd,"$pp") or return(undef);
	}
	while(read($fd,$cline,1024)) {
		$data.=$cline;
	}
	close($fd);
	my $size=length($data);
	$data="$size $pp\n$data";
	return \$data;
}

#########################################################################
# Return the matching file name [no path component] or undef if such	#
# a file does not exist.						#
#########################################################################

sub get_report_filename($$$$$) {
my ($self,$dir,$report,$inst,$mtime)=@_;

	$inst--;
	my $cache_line=check_cache($self,$dir,$report);
	my $c=@{$cache_line->{files}};
	if(!$c) {
		return undef; # no such report available
	}

	my $ff;
	if($inst>-1) {
		$ff=$cache_line->{files}->[$inst];
	} else {
		for my $x (@{$cache_line->{files}}) {
			if($x->[2] == $mtime) {
				$ff=$x; last;
			}
		}
	}
	if(!defined($ff)) {
		return undef; # No such report
	}
	my $fname=$ff->[0];
	$fname =~ s/\.gz$//;
	$fname =~ s/\.Z$//;
	return basename($fname);
}

sub send_file_contents($$$) {
my ($self,$fd,$file)=@_;

	my $rd;
	my $pp;
	if($file =~ /\.gz$/) {
		$pp="$self->{gunzip} -c $file|";
	} elsif($file =~ /\.Z$/) {
		$pp="$self->{zcat} $file|";
	} else {
		$pp=$file;
	}

	my $data="";
	if(!open($rd,"$pp")) {
		print $fd "ERROR: UNREADABLE\n";
		return;
	}
	while(read($rd,$cline,1024)) {
		$data.=$cline;
	}
	close($rd);
	print $fd length($data),"\n";
	print $fd $data;
}
sub get_file_contents($$) {
my ($self,$file)=@_;

	my $rd;
	my $pp;
	if($file =~ /\.gz$/) {
		$pp="$self->{gunzip} -c $file|";
	} elsif($file =~ /\.Z$/) {
		$pp="$self->{zcat} $file|";
	} else {
		$pp=$file;
	}

	my $data="";
	if(!open($rd,"$pp")) {
		return(0,"ERROR: UNREADABLE\n");
	}
	while(read($rd,$cline,1024)) {
		$data.=$cline;
	}
	close($rd);
	return(1,$data);
}

1;
